home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / util / misc / OneFont_r1.lha / OneFont.s < prev   
Text File  |  1994-11-02  |  7KB  |  260 lines
  1. ;**********************************************************************
  2. ;
  3. ;         (c) 1994 J.Skypala & Z.Kabelac
  4. ;                        kabi@fi.muni.cz
  5. ;          $VER: OneFont.s 4.0 (25.8.94)
  6. ;
  7. ;**********************************************************************
  8. ;Have you been wondering how can you change font in Execute command?
  9. ;Well, maybe this is the solution for you - try this small program.
  10. ;Just remember to run this program from CLI >BEFORE< workbench OPENS
  11. ;any screen after reboot.
  12. ;Program is patching SetFont (and also, if you want, OpenFont and OpenDiskFont)
  13. ;But not all programs need this patch - they are not font sensitive or they
  14. ;can select font in its preferences.  You have to insert name of those programs
  15. ;in the tasks'list in this source file (some of them are listed here : text and
  16. ;font editors (to be possible to use topaz font) and some old and not font
  17. ;sensitive programs, but you still could select 8x8 font for them (if you have
  18. ;nicer or localized fonts). To find task's names use ARTM or some similar
  19. ;program (you only need a few starting letters (4 - 6) to indentify task).
  20. ;
  21. ;for compiling this source you need Includes for 2.0 system
  22. ;  Thinpaz is really nice font for this purpose
  23. ;
  24. ;feel free to change anything you want
  25. ;if its really good change in this program - send me a copy:
  26. ;    kabi@fi.muni.cz
  27.  
  28.  
  29.         incdir    'Include:'
  30.         include    'exec/tasks.i'
  31.         include    'exec/exec_lib.i'
  32.         include    'exec/memory.i'
  33.         include    'graphics/graphics_lib.i'
  34.         include    'graphics/text.i'
  35.         include    'graphics/rastport.i'
  36.         include    'diskfont/diskfont_lib.i'
  37.  
  38. _SysBase    equ    4
  39.  
  40. ;set it 1 if you want patch also OpenFont & OpenDiskFont
  41. PATCH_OPEN    SET    0
  42.  
  43. Start        move.l    (_SysBase).w,a6
  44.         moveq    #0,d0
  45.         lea    diskfontname(pc),a1
  46.         jsr    _LVOOpenLibrary(a6)
  47.         tst.l    d0
  48.         beq.w    BadEnd            ;Sorry no lib
  49.         move.l    d0,a6
  50.         move.l    a6,a3
  51.         lea    TopazDefault(pc),a0
  52.         jsr    _LVOOpenDiskFont(a6)    ;TOPAZ 8
  53.         lea    FontDefault(pc),a4
  54.         move.l    d0,(a4)+
  55.         beq.w    CloseLib
  56.         lea    TAttr(pc),a0        ;Open Desired Font
  57.         jsr    _LVOOpenDiskFont(a6)
  58.         move.l    d0,(a4)+
  59.         beq.w    CloseLib
  60.         lea    Instead(pc),a0        ;Open Instead Topaz Font
  61.         jsr    _LVOOpenDiskFont(a6)
  62.         move.l    d0,(a4)+
  63.         beq.w    CloseLib
  64.  
  65. ;------- Allocate memory for resident part of program
  66.  
  67.         move.l    (_SysBase).w,a6
  68.         move.l    #ResidentEnd-ResidentStart,d4
  69.         move.l    d4,d0
  70.         moveq    #MEMF_PUBLIC,d1
  71.         jsr    _LVOAllocMem(a6)    ;allocate memory
  72.         tst.l    d0
  73.         beq.b    CloseLib
  74.         move.l    d0,a0
  75.         move.l    d0,a4
  76.         lea    ResidentStart(pc),a1
  77. .loop        move.b    (a1)+,(a0)+        ;and move resident part
  78.         subq.w    #1,d4
  79.         bne.b    .loop            ;there
  80.  
  81.     IFNE    PATCH_OPEN
  82.         move.l    a3,a1            ;Base of diskfont.library
  83.         move.w    #_LVOOpenDiskFont,a0
  84.         moveq    #DiskFont-ResidentStart,d0
  85.         add.l    a4,d0
  86.         jsr    _LVOSetFunction(a6)    ;patch OpenDiskFont()
  87.         move.l    d0,OpenDiskFont-ResidentStart(a4)
  88.     ENDC
  89.         lea    gfxname(pc),a1
  90.         moveq    #0,d0
  91.         jsr    _LVOOpenLibrary(a6)    ;open graphics.library
  92.         tst.l    d0
  93.         beq.b    EndPatch
  94.         move.l    d0,a1
  95.         move.w    #_LVOSetFont,a0
  96.         moveq    #GfxSetFont-ResidentStart,d0
  97.         add.l    a4,d0
  98.         jsr    _LVOSetFunction(a6)     ;patch SetFont()
  99.         move.l    d0,SetFont-ResidentStart(a4)
  100.  
  101.     IFNE    PATCH_OPEN
  102.         move.w    #_LVOOpenFont,a0
  103.         moveq    #GfxFont-ResidentStart,d0
  104.         add.l    a4,d0
  105.         jsr    _LVOSetFunction(a6)    ;patch OpenFont()
  106.         move.l    d0,OpenFont-ResidentStart(a4)
  107.     ENDC
  108.  
  109. EndPatch
  110.     IFEQ    PATCH_OPEN
  111.         move.l    a3,a1
  112.         move.l    (_SysBase).w,a6
  113.         jsr    _LVOCloseLibrary(a6)
  114.     ENDC
  115.         moveq    #0,d0
  116.         rts
  117. CloseLib    move.l    a3,a1
  118.         move.l    (_SysBase).w,a6
  119.         jsr    _LVOCloseLibrary(a6)
  120. BadEnd        moveq    #10,d0
  121.         rts
  122. ***********************************************************************
  123. ResidentStart
  124. SaveSetRegs    reg    d0/d1/a0/a1/a2/a6
  125. SaveRegs    reg    d0/a0/a2/a6
  126.  
  127. GfxSetFont    move.l    SetFont(pc),-(a7)
  128.         cmp.l    FontDefault(pc),a0
  129.         bne.b    .not_for_us
  130.         movem.l    SaveSetRegs,-(a7)
  131.         bsr.b    GetTheName
  132.         movem.l    (a7)+,SaveSetRegs
  133.         move.l    FontInstead(pc),a0
  134.         bne.b    .nochange
  135.         move.l    FontAddr(pc),a0
  136. ;we have to prevent removing font from memory
  137. ;because if only SetFont is patched than CloseFont will decrease open counter
  138. ;of new font instead of topaz font
  139. .nochange    move.b    #20,$1f(a0)            ;Open Count
  140. .not_for_us    rts
  141.  
  142.     IFNE    PATCH_OPEN
  143. GfxFont        move.l    OpenFont(pc),-(a7)    ;address of OpenFont()
  144.         bra.b    Patching        ;and the rest is same
  145. DiskFont    move.l    OpenDiskFont(pc),-(a7)    ;address of OpenDiskFont()
  146.  
  147. Patching    cmp.w    #8,ta_YSize(a0)        ;is it size 8?
  148.         bne.b    .end
  149.         move.l    a1,-(a7)
  150.         movem.l    SaveRegs,-(a7)
  151.         move.l    (a0),a0
  152.         lea    TopazName(pc),a1
  153. .loop        move.b    (a0)+,d0        ;is it 'topaz.font'
  154.         cmp.b    (a1)+,d0
  155.         bne.b    .notopaz
  156.         tst.b    d0
  157.         bne.b    .loop
  158.         bsr.b    GetTheName
  159.         beq.b    .not_in_list
  160.         movem.l    (a7)+,SaveRegs
  161.         lea    InsteadTopaz(pc),a1
  162.         bra.b    .con
  163. .not_in_list    movem.l    (a7)+,SaveRegs
  164.         lea    FontName(pc),a1        ;change it to
  165. .con        move.l    a1,(a0)            ;desired font
  166.         bra.b    ..
  167. .notopaz    movem.l    (a7)+,SaveRegs
  168. ..        move.l    (a7)+,a1
  169. .end        rts                ;and do the original func.
  170.     ENDC
  171.  
  172. GetTheName    move.l    (_SysBase).w,a6
  173.         sub.l    a1,a1            ;Zero - find our name
  174.         jsr    _LVOFindTask(a6)
  175.         move.l    d0,a1
  176.  
  177.         move.l    $ac(a1),d0        ;task pointer
  178.         beq.b    .normal            ;not CLI
  179.         asl.l    #2,d0
  180.         move.l    d0,a2
  181.         move.l    $10(a2),d0
  182.         beq.b    .normal
  183.         asl.l    #2,d0
  184.         addq.l    #1,d0
  185.         move.l    d0,a1
  186.         bra.b    .shell_proc             ;yes it's CLI process
  187. .normal        move.l    LN_NAME(a1),a1        ;Get the address of task's name
  188. .shell_proc    lea    TasksNames(pc),a2
  189. .mainloop    move.l    a1,a0
  190.         tst.b    (a2)
  191.         beq.b    .notfound
  192.  
  193. .nextbyte    move.b    (a2)+,d0
  194.         beq.b    .found            ;found => not patching
  195. .search        move.b    (a0)+,d1
  196.         eor.b    d1,d0
  197.         and.b    #%11011111,d0        ;not case sensitive
  198.         beq.b    .nextbyte
  199.  
  200. .catch_end    tst.b    (a2)+
  201.         bne.b    .catch_end
  202.         bra.b    .mainloop        ;make another search
  203. .found        subq.b    #1,d0            ;set NOT ZERO
  204. .notfound    rts
  205.  
  206.     IFNE    PATCH_OPEN
  207. OpenDiskFont    dc.l    0
  208. OpenFont    dc.l    0
  209.     ENDC
  210. SetFont        dc.l    0
  211. ;don't touch this sequence!!!
  212. FontDefault    dc.l    0
  213. FontAddr    dc.l    0
  214. FontInstead    dc.l    0
  215. TopazName    dc.b    'topaz.font',0
  216.  
  217. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  218. ;Font instead topaz - must be 8x8 !!!
  219.  
  220. InsteadTopaz    dc.b    'topaz.font',0
  221.  
  222. ;Font normaly used - any type - but don't expect that everything
  223. ;run ok if you set 100x100 font :-)
  224.  
  225. FontName    dc.b    'thinpaz.font',0
  226. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  227.  
  228. ;**** TASK LIST ********************************************************
  229. ;You need only starting letters
  230. TasksNames    dc.b    "DISKMON",0
  231.         dc.b    "ASM",0            ;no case sensitive !!!!
  232.         dc.b    "TRASH",0
  233.         dc.b    "VIEW80",0
  234.         dc.b    "DW",0
  235.         dc.b    "GOLD",0
  236.         dc.b    "WBFED",0
  237.         dc.b    "PFM",0
  238.         dc.b    "DEKSID",0
  239.         dc.b    "QBTOOL",0
  240.         dc.b    0                  ;end of list
  241.  
  242.         EVEN
  243. ResidentEnd
  244. ;***********************************************************************
  245. ;set right TAtributes for your font
  246. TAttr        dc.l    FontName
  247.         dc.w    8
  248.         dc.w    0
  249. Instead        dc.l    InsteadTopaz
  250.         dc.w    8
  251.         dc.w    0
  252. TopazDefault    dc.l    TopazName
  253.         dc.w    8
  254.         dc.w    0
  255.  
  256.  
  257. version        dc.b    '$VER: OneFont 4.0 (25/8/94)',0
  258. diskfontname    dc.b    'diskfont.library',0
  259. gfxname        dc.b    'graphics.library',0
  260.